perm filename RHQUIK.F4[NEW,LCS] blob
sn#493280 filedate 1980-01-27 generic text, type T, neo UTF8
00100 SUBROUTINE RHQUIK
00200 C TRANSLATES Z=W, X=H, C=Q, V=E, B=S
00300 COMMON /ALF/INP(72)
00310 DO 5 LEND=72,1,-1
00320 5 IF(INP(LEND).NE.' ')GO TO 6
00325 C**** BUT WHAT ABOUT MOTIVES????????
00330 6 DO 7 K=1,LEND
00340 N=INP(K)
00350 7 IF(N.EQ.'Z'.OR.N.EQ.'C'.OR.N.EQ.'V'.OR.N.EQ.'B')GO TO 8
00355 C GOES BACK IF NO SPECIAL RHYTHM CHARACTERS FOUND. (ASSUMES NO LONE X)
00360 RETURN
00400 8 DO 1 K=1,LEND
00500 N=INP(K)
00550 IF(N.EQ.' ')GO TO 1
00600 IF(N.EQ.'Z')INP(K)='W'
00700 IF(N.EQ.'C')INP(K)='Q'
00800 IF(N.EQ.'V')INP(K)='E'
00900 IF(N.EQ.'B')INP(K)='S'
01000 IF(N.NE.'X')GO TO 1
01010 C SO X ISN'T CONFUSED WITH /QX16/ ETC.
01050 IF(K.EQ.1)GO TO 3
01100 DO 2 J=K-1,1,-1
01200 L=INP(J)
01300 IF(L.EQ.' ')GO TO 2
01400 IF(L.NE.'/')GO TO 1
01410 3 INP(K)='H'
01420 GO TO 1
01500 2 CONTINUE
01600 1 CONTINUE
01610 TYPE 4,(INP(K),K=1,LEND)
01620 4 FORMAT(1X72A1)
01630 END